home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / OASGN.C < prev    next >
Text File  |  1990-03-02  |  7KB  |  295 lines
  1. /*
  2.  * File: oasgn.c
  3.  *  Contents: asgn, rasgn, rswap, swap
  4.  */
  5.  
  6. #include "::h:config.h"
  7. #include "::h:rt.h"
  8. #include "rproto.h"
  9.  
  10. #ifdef PreProcess
  11. /* include(../M4/ops.m4) /* */
  12. /* */
  13. #endif                    /* PreProcess */
  14.  
  15. /*
  16.  * x := y - assign y to x.
  17.  */
  18.  
  19. OpDcl(asgn,2,":=")
  20.    {
  21.    /*
  22.     * Make sure that Arg1 is a variable.
  23.     */
  24.    if (!Var(Arg1)) 
  25.       RunErr(111, &Arg1);
  26.  
  27.    /*
  28.     * The returned result is the variable to which assignment is being
  29.     *  made.
  30.     */
  31.    Arg0 = Arg1;
  32.  
  33.    /*
  34.     * All the work is done by doasgn.  Note that Arg1 is known
  35.     *  to be a variable.
  36.     */
  37.    switch (doasgn(&Arg1, &Arg2)) {
  38.       case Success:
  39.          Return;
  40.       case Failure:
  41.          Fail;
  42.       case Error:
  43.          RunErr(0, NULL);
  44.       }
  45.    }
  46.  
  47. /*
  48.  * x <- y - assign y to x.
  49.  * Reverses assignment if resumed.
  50.  */
  51.  
  52. OpDcl(rasgn,2,"<-")
  53.    {
  54.  
  55.    /*
  56.     * Arg1 must be a variable.
  57.     */
  58.    if (!Var(Arg1)) 
  59.       RunErr(111, &Arg1);
  60.  
  61.    /*
  62.     * The return value is the variable Arg1, so make a copy of it before
  63.     *  it is dereferenced.
  64.     */
  65.    Arg0 = Arg1;
  66.    if (DeRef(Arg1) == Error) 
  67.       RunErr(0, NULL);
  68.  
  69.    /*
  70.     * Assign Arg2 to Arg1 and suspend.
  71.     */
  72.    switch (doasgn(&Arg0, &Arg2)) {
  73.       case Success:
  74.          Suspend;
  75.          break;
  76.       case Failure:
  77.          Fail;
  78.       case Error:
  79.          RunErr(0, NULL);
  80.       }
  81.    /*
  82.     * Reverse the assignment by assigning the old value
  83.     *  of back and fail.
  84.     */
  85.    if (doasgn(&Arg0, &Arg1) == Error) 
  86.       RunErr(0, NULL);
  87.    Fail;
  88.    }
  89.  
  90. /*
  91.  * x <-> y - swap values of x and y.
  92.  * Reverses swap if resumed.
  93.  */
  94.  
  95. OpDcl(rswap,2,"<->")
  96.    {
  97.    register union block *bp1, *bp2;
  98.    word adj1, adj2;
  99.  
  100.    /*
  101.     * Arg1 and Arg2 must be variables.
  102.     */
  103.    if (!Var(Arg1)) {
  104.       RunErr(111, &Arg1);
  105.       }
  106.    if (!Var(Arg2)) {
  107.       RunErr(111, &Arg2);
  108.       }
  109.  
  110.    /*
  111.     * Make copies of Arg1 and Arg2 as variables in Arg0 and Arg3.
  112.     */
  113.    Arg0 = Arg1;
  114.    Arg3 = Arg2;
  115.    adj1 = adj2 = 0;
  116.    if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
  117.       bp1 = BlkLoc(Arg1);
  118.       bp2 = BlkLoc(Arg2);
  119.       if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar) &&
  120.       Offset(bp1->tvsubs.ssvar) == Offset(bp2->tvsubs.ssvar)) {
  121.          /*
  122.           * Arg1 and Arg2 are both substrings of the same string; set
  123.           *  adj1 and adj2 for use in locating the substrings after
  124.           *  an assignment has been made.  If Arg1 is to the right of Arg2,
  125.           *  set adj1 := *Arg1 - *Arg2, otherwise if Arg2 is to the right of
  126.           *  Arg1, set adj2 := *Arg2 - *Arg1.  Note that the adjustment values
  127.           *  may be negative.
  128.           */
  129.          if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
  130.             adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
  131.          else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
  132.             adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
  133.             }
  134.       }
  135.    if (DeRef(Arg1) == Error) {
  136.       RunErr(0, NULL);
  137.       }
  138.    if (DeRef(Arg2) == Error) {
  139.       RunErr(0, NULL);
  140.       }
  141.    /*
  142.     * Do Arg1 := Arg2
  143.     */
  144.    switch (doasgn(&Arg0, &Arg2)) {
  145.       case Success:
  146.          break;
  147.       case Failure:
  148.          Fail;
  149.       case Error:
  150.          RunErr(0, NULL);
  151.       }
  152.    if (adj2 != 0)
  153.       /*
  154.        * Arg2 is to the right of Arg1 and the assignment Arg := Arg2 has
  155.        *  shifted the position of Arg2.  Add adj2 to the position of Arg2
  156.        *  to account for the replacement of Arg1 by Arg2.
  157.        */
  158.       BlkLoc(Arg3)->tvsubs.sspos += adj2;
  159.    /*
  160.     * Do Arg2 := Arg1
  161.     */
  162.    switch (doasgn(&Arg3, &Arg1)) {
  163.       case Success:
  164.          break;
  165.       case Failure:
  166.          Fail;
  167.       case Error:
  168.          RunErr(0, NULL);
  169.       }
  170.    if (adj1 != 0)
  171.       /*
  172.        * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1 has
  173.        *  shifted  the position of Arg1.  Add adj2 to the position of Arg1
  174.        *  to account for the replacement of Arg2 by Arg1.
  175.        */
  176.       BlkLoc(Arg0)->tvsubs.sspos += adj1;
  177.    /*
  178.     * Suspend Arg1 with the assignment in effect.
  179.     */
  180.    Suspend;
  181.    /*
  182.     * If resumed, the assignments are undone.  Note that the string position
  183.     *  adjustments are opposite those done earlier.
  184.     */
  185.    switch (doasgn(&Arg0, &Arg1)) {        /* restore Arg1 */
  186.       case Success:
  187.          break;
  188.       case Failure:
  189.          Fail;
  190.       case Error:
  191.          RunErr(0, NULL);
  192.       }
  193.    if (adj2 != 0)
  194.       BlkLoc(Arg3)->tvsubs.sspos -= adj2;
  195.    switch (doasgn(&Arg3, &Arg2))  {       /* restore Arg2 */
  196.       case Success:
  197.          break;
  198.       case Failure:
  199.          Fail;
  200.       case Error:
  201.          RunErr(0, NULL);
  202.       }
  203.    if (adj1 != 0)
  204.       BlkLoc(Arg0)->tvsubs.sspos -= adj1;
  205.    Fail;
  206.    }
  207.  
  208. /*
  209.  * x :=: y - swap values of x and y.
  210.  */
  211.  
  212. OpDcl(swap,2,":=:")
  213.    {
  214.    register union block *bp1, *bp2;
  215.    word adj1, adj2;
  216.  
  217.    /*
  218.     * Arg1 and Arg2 must be variables.
  219.     */
  220.    if (!Var(Arg1)) {
  221.       RunErr(111, &Arg1);
  222.       }
  223.    if (!Var(Arg2)) {
  224.       RunErr(111, &Arg2);
  225.       }
  226.    /*
  227.     * Make copies of Arg1 and Arg2 as variables in Arg0 and Arg3.
  228.     */
  229.    Arg0 = Arg1;
  230.    Arg3 = Arg2;
  231.    adj1 = adj2 = 0;
  232.    if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
  233.       bp1 = BlkLoc(Arg1);
  234.       bp2 = BlkLoc(Arg2);
  235.       if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar) &&
  236.       Offset(bp1->tvsubs.ssvar) == Offset(bp2->tvsubs.ssvar)) {
  237.          /*
  238.       * Arg1 and Arg2 are both substrings of the same string, set
  239.       *  adj1 and adj2 for use in locating the substrings after
  240.       *  an assignment has been made.  If Arg1 is to the right of Arg2,
  241.       *  set adj1 := *Arg1 - *Arg2, otherwise if Arg2 is to the right of
  242.           *  Arg1, set adj2 := *Arg2 - *Arg1.  Note that the adjustment
  243.           *  values may be negative.
  244.       */
  245.          if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
  246.             adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
  247.          else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
  248.             adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
  249.         }
  250.       }
  251.    if (DeRef(Arg1) == Error) {
  252.       RunErr(0, NULL);
  253.       }
  254.    if (DeRef(Arg2) == Error) {
  255.       RunErr(0, NULL);
  256.       }
  257.    /*
  258.     * Do Arg1 := Arg2
  259.     */
  260.    switch (doasgn(&Arg0, &Arg2)) {
  261.       case Success:
  262.          break;
  263.       case Failure:
  264.          Fail;
  265.       case Error:
  266.          RunErr(0, NULL);
  267.       }
  268.    if (adj2 != 0)
  269.       /*
  270.        * Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
  271.        *  shifted the position of Arg2.  Add adj2 to the position of Arg2
  272.        *  to account for the replacement of Arg1 by Arg2.
  273.        */
  274.       BlkLoc(Arg3)->tvsubs.sspos += adj2;
  275.    /*
  276.     * Do Arg2 := Arg1
  277.     */
  278.    switch (doasgn(&Arg3, &Arg1)) {
  279.       case Success:
  280.          break;
  281.       case Failure:
  282.          Fail;
  283.       case Error:
  284.          RunErr(0, NULL);
  285.       }
  286.    if (adj1 != 0)
  287.       /*
  288.        * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1 has
  289.        *  shifted the position of Arg1.  Add adj2 to the position of Arg1 to
  290.        *  account for the replacement of Arg2 by Arg1.
  291.        */
  292.       BlkLoc(Arg0)->tvsubs.sspos += adj1;
  293.    Return;
  294.    }
  295.